module Main where

import Prelude hiding (readFile, writeFile, log, putStrLn, getLine)
import System.IO.UTF8 (readFile, writeFile, putStrLn, getLine, hPutStr)
import System.IO hiding (readFile, writeFile, putStrLn, getLine, hPutStr)
import System.Environment
import System.Directory
import Control.Arrow
import Control.Monad
import Control.Concurrent
import Data.Char
import Data.Maybe
import Data.List
import Codec.Binary.Base64.String
import WS.Runtime.XML
import WS.Runtime.Main
import XI.Directory.GetXiObj
import XI.Directory.Todo
import XI.Directory.Parser
import XI.Directory.Types
import Hixay.UI.UserData

main :: IO ()
main = getArgs >>= run

data HixParams = HixParams {
        host        :: String,
        port        :: Int,
        user        :: String,
        pwd         :: String,
        proxy       :: Maybe String,
        log         :: Maybe String,
        scriptRes   :: String,
        xmlRes      :: String,
        xmlSLA      :: String,
        xmlScenarios    :: String
    } deriving (Show)
    
parseParams :: String -> HixParams
parseParams s 
    | no "host" = err "Host"
    | no "port" = err "Port"
    | no "user" = err "User"
    | null wport = error "Port couldn't be empty"
    | not $ all isDigit $ head wport = error "Port should be a number"
    
    | otherwise = HixParams {
        host = val "host",
        port = read $ head wport,
        user = val "user",
        pwd = "",
        proxy = mbVal "proxy",
        log = mbVal "log",
        scriptRes = vd "script.res" "script-res",
        xmlRes = vd "script.xml" "xml-res",
        xmlSLA = vd "sla.xml" "xml-data",
        xmlScenarios = vd "scenarios.xml" "xml-scenarios"
    }
    where
        pairs = map ((map toLower . delete ' ' *** dropWhile (`elem` " =")) . break (=='=') . takeWhile (/= '#')) . lines $ s
        mbVal = liftM (head . words) . flip lookup pairs
        val = fromJust . mbVal
        vd d = fromMaybe d . mbVal
        no = isNothing . mbVal
        err = error . (++ " is not found in params")
        wport = words $ val "port"
    
run :: [String] -> IO ()
run [] = putStr $ unlines [
        "Usage: hix_c <param-file>", 
        "", 
        "Param-file contains lines <param> = <value>. Use '#' to comment the rest of string.",
        "Available params are",
        "\thost: SAP WAS host name",
        "\tport: SAP WAS host port",
        "\tuser: SAP WAS username",
        "\tproxy: web-sevices proxy-file (optional)",
        "\tlog: web-sevices log-file (optional)",
        "\tscript-res: name of generated script file (default is 'script.res')",
        "\txml-res: name of generated xml file (default is 'script.xml')",
        "\txml-sla: name of user-edited xml-file for SLA-data (would be generated if not exists yet). Default is sla.xml",
        "\txml-scenarios: name of user-edited xml-file for scenario notes (would be generated if not exists yet). Default is scenarios.xml"
    ]
    
run (s:_) = liftM2 (\p pw -> (parseParams p) { pwd = pw }) (readFile s) askPwd >>= \hp -> putStrLn "Working... " >> 
        getWsParam hp >>= \wsp -> getConfiguration wsp >>= forkIO . (error ||| processCfg hp) >> saveProxy wsp
    
processCfg :: HixParams -> Configuration -> IO ()
processCfg hp cfg = 
    liftM2 (\rsla rsc -> mergeUserData (fst cfg) (fromXml "sla" "sender" rsla) (fromXml "scenarios" "scenario" rsc)) 
        (rf xmlSLA) (rf xmlScenarios) >>= 
    \(sc, sla, scn) -> 
    writeFile (scriptRes hp) (unlines $ scriptDir cfg) >> writeFile (xmlRes hp) (toXml "root" "Scenario" sc) >> 
    wf xmlSLA (toXml "sla" "sender" sla) >> wf xmlScenarios (toXml "scenarios" "scenario" scn) >> return ()
    where
        rf fld = (catch (readFile (fld hp)) (\_ -> return ""))
        wf fld xml = forkIO $ openTempFile "." (fld hp) >>= \(fp,h) -> hPutStr h xml >> hClose h >> copyFile fp (fld hp) >> removeFile fp

askPwd :: IO String
askPwd = putStrLn "Enter a password:" >> hSetEcho stdin False >> getLine >>= \s -> hSetEcho stdin True >> return s

getConfiguration :: WsParams -> IO (Either String Configuration)
getConfiguration ws_param = liftM (scenarios . concat) (mapM setVar [getCC, getSA, getRA, getRD, getID, getCS, getIP] >>= mapM takeMVar) 
--    saveProxy ws_param >> return (scenarios res)
    where
        setVar f = newEmptyMVar >>= \res -> forkIO (f ws_param >>= putMVar res) >> return res
        
getWsParam :: HixParams -> IO WsParams
getWsParam hp = liftM2 (\pr lv -> WsParams {
        wspProxyMVar = pr,
        wspLogMVar = lv,
        wspServer = host hp ++ ":" ++ show (port hp),
        wspAuthorization = Just $ "Basic " ++ encode (user hp ++ ":" ++ pwd hp),
        wspProxy = proxy hp,
        wspProtocolStr = "HTTPBasicAuth?style=document",
        wspLog = log hp
    }) (wsProxy (proxy hp) >>= newMVar) (newMVar ())

